;; host/byte.scm - (c) rohan drape, 2001-2005

(module 
 byte mzscheme

(require "srfi.scm")

;; Must provide procedures for converting to and from binary integer
;; types and IEEE floating point representations and the respective
;; scheme types.  See the PLT manual for detailed descriptions.

;; This is the PLT interface without optional arguments, without the
;; ability to provide storage, and operating on <u8vector> instead of
;; <bytes>.

(define (integer->u8vector* n size-n signed? big-endian?)
  (bytes->u8vector 
   (integer->integer-bytes n size-n signed? big-endian?)))

(define (u8vector->integer* b signed? big-endian?)
  (integer-bytes->integer 
   (u8vector->bytes b)
   signed? 
   big-endian?))

;; Variants that are extended to handle the case of one-byte integers.
;; In that case the endian indication is obviously meaningless.

(define (integer->u8vector n size-n signed? big-endian?)
  (if (= size-n 1)
      (if signed?
	  (u8vector (if (negative? n) (+ n 256) n))
	  (u8vector n))
      (integer->u8vector* n size-n signed? big-endian?)))

(define (u8vector->integer b signed? big-endian?)
  (if (= (u8vector-length b) 1)
      (let ((n (u8vector-ref b 0)))
	(if (and signed? (> n 127))
	    (- n 256)
	    n))
      (u8vector->integer* b signed? big-endian?)))
  
;; This is the PLT interface without optional arguments, without the
;; ability to provide storage, and operating on <u8vector> instead of
;; <bytes>.

(define (real->u8vector n size-n big-endian?)
  (bytes->u8vector 
   (real->floating-point-bytes n size-n big-endian?)))

(define (u8vector->real b big-endian?)
  (floating-point-bytes->real 
   (u8vector->bytes b)
   big-endian?))

;; As of 299.20 mzscheme has a primitive type <bytes> for a byte
;; string.  Conversion to and from SRFI-4 <u8vector>.  The new PLT
;; <bytes> type is identical is function to the SRFI <u8vector>
;; type.

(define (bytes->u8vector s)
  (let* ((l (bytes-length s))
	 (v (make-u8vector l)))
    (do ((i 0 (+ i 1)))
	((= i l))
      (u8vector-set! v i (bytes-ref s i)))
    v))

(define (u8vector->bytes v) 
  (let* ((l (u8vector-length v))
	 (s (make-bytes l)))
    (do ((i 0 (+ i 1)))
	((= i l))
      (bytes-set! s i (u8vector-ref v i)))
    s))

(define (read-u8vector count port)
  (bytes->u8vector (read-bytes count port)))

(define (write-u8vector b . port)
  (apply write-bytes (u8vector->bytes b) port))

;; Variant of <string> ports.

(define (open-input-u8vector u8vector)
  (open-input-bytes (u8vector->bytes u8vector)))

(define (open-output-u8vector)
  (open-output-bytes))

(define (get-output-u8vector port)
  (bytes->u8vector (get-output-bytes port)))

(provide (all-defined)))
